home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue50 / IPC / Mailslots / API / ClientMainFormUnit.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-08-28  |  1.7 KB  |  76 lines
  1. unit ClientMainFormUnit;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   StdCtrls;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     Memo1: TMemo;
  12.     procedure FormCreate(Sender: TObject);
  13.     procedure FormDestroy(Sender: TObject);
  14.     procedure Memo1Change(Sender: TObject);
  15.   private
  16.     Mailslot: THandle;
  17.   end;
  18.  
  19. {$ifdef Ver90}
  20.   //This exception class did not exist in Delphi 2
  21.   EWin32Error = class(Exception);
  22. {$endif}
  23.  
  24. var
  25.   Form1: TForm1;
  26.  
  27. const
  28.   MailslotNameLocalWritePrefix = '\\.\mailslot\';
  29.   MailslotName = 'SampleMailslot';
  30.   MailslotWriteName = MailslotNameLocalWritePrefix + MailslotName;
  31.  
  32. implementation
  33.  
  34. {$R *.DFM}
  35.  
  36. function Win32Check(RetVal: Bool): Bool;
  37. var
  38.   LastError: DWORD;
  39. begin
  40.   Result := RetVal;
  41.   if not RetVal then
  42.   begin
  43.     LastError := GetLastError;
  44.     if LastError <> ERROR_SUCCESS then
  45.       raise EWin32Error.CreateFmt( 'Win32 Error.  Code: %d.'#10'%s',
  46.         [LastError, SysErrorMessage(LastError)])
  47.     else
  48.       raise EWin32Error.Create('A Win32 API function failed')
  49.   end;
  50. end;
  51.  
  52. procedure TForm1.FormCreate(Sender: TObject);
  53. begin
  54.   Mailslot := CreateFile(
  55.     MailslotWriteName, Generic_Write, File_Share_Read,
  56.       nil, Open_Existing, File_Attribute_Normal, 0);
  57.   if Mailslot = Invalid_Handle_Value then
  58.     raise EWin32Error.Create('Cannot open client side of mailslot');
  59. end;
  60.  
  61. procedure TForm1.FormDestroy(Sender: TObject);
  62. begin
  63.   CloseHandle(Mailslot);
  64. end;
  65.  
  66. procedure TForm1.Memo1Change(Sender: TObject);
  67. var
  68.   BytesWritten: DWord;
  69.   Msg: String;
  70. begin
  71.   Msg := Memo1.Text;
  72.   Win32Check(WriteFile(Mailslot, Msg[1], Length(Msg),
  73.                    BytesWritten, nil));
  74. end;
  75.  
  76. end.